home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL1NO1.ARC / MACRO.LSP < prev    next >
Encoding:
Text File  |  1986-06-11  |  2.2 KB  |  65 lines
  1.  
  2. ;********************************************************************
  3. ;                             MACRO
  4. ;  Lets a user define a sequence of commands which can be executed
  5. ;  by pressing a single key or a combination of keys. For example,
  6. ;  a user could define the key combination EL to execute the commands
  7. ;  erase last redraw. The program actually uses the user's input
  8. ;  to create a new AUTOCAD command in the form of a C: function.
  9. ;            K. Funk       Version 1.0          May 10,1986.
  10. ;********************************************************************
  11.  
  12. (setq MacList ())
  13.  
  14. ;FUNCTION MACRO - creates keyboard macros.
  15. (defun C:MACRO ()
  16.    (setq Key (getstring "\nMacro Key(s): "))
  17.    (setq Key (strcat "C:" Key))
  18.    (cond ((/= Key "C:")
  19.       (setq Mac (list 'Command))
  20.       (setq Cmd "")
  21.       (While (/= Cmd ".")
  22.          (setq Cmd (getstring "\nMacro Def (. to end): "))
  23.          (If (/= Cmd ".") (setq Mac (cons Cmd Mac)))
  24.       )
  25.       (setq Ans "")
  26.       (While (NOT (member Ans '("Y" "y" "N" "n")))
  27.          (setq Ans (getstring "\nCreate Macro (Y/N): ")))
  28.       (cond ((member Ans '("Y" "y"))
  29.          (setq Mac (reverse Mac))
  30.          (setq MacDef (list 'defun (read Key) '() Mac))
  31.          (setq MacList (cons MacDef MacList))
  32.          (eval MacDef))
  33.       ))
  34.    )
  35. )
  36.  
  37. ;FUNCTION C:MACSAVE - saves macros defined in this session to disk.
  38. (defun C:MACSAVE ()
  39.    (setq Exist "T")
  40.    (While (= Exist "T")
  41.       (setq FN "")
  42.       (While (= FN "")
  43.          (setq FN (getstring "\nFilename: ")))
  44.       (setq FN (strcat FN ".LSP"))
  45.       (setq FU (open FN "r"))      ;check for existing file
  46.       (cond ((NULL FU)
  47.                (setq Exist "N"))
  48.             (T
  49.                (close FU)
  50.                (setq Ans "")
  51.                (While (NOT (member Ans '("Y" "y" "N" "n")))
  52.  
  53.                  (cond  (null FN))
  54.                  (while (member ans ("QUIT" "Quit" "quit")))
  55.                  )
  56.   
  57.                 (setq Ans (getstring "\nFile Already Exists...Replace(Y/N): ")))
  58.                (If (member Ans '("Y" "y")) (setq Exist "N")))
  59.       )  ;end cond
  60.    ) ;end while
  61.    (setq FU (open FN "w"))
  62.    (foreach Macrow MacList (print Macrow FU))
  63.    (close FU)
  64. )
  65.